home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
COMAL
/
B-Book Series
/
(k)b2.d64
/
correct
< prev
next >
Wrap
Text File
|
2007-02-28
|
4KB
|
164 lines
0010 //OLDHAM'S GRAMMAR SCHOOL//
0020 //PROGRAM TO ADMINISTER PUPILS' MARKS//
0030 //WRITTEN BY CHRIS BORGE IN CBM COMAL-80//
0040 //THIS VERSION: OCT. 1981//
0050 //THIS PART: TO MAKE CORRECTIONS //
0060 //
0070 MAX:=8
0080 DIM NAME$(MAX) OF 20, ANSW$ OF 10
0090 DIM THISNAME$ OF 20
0100 DIM MARK(MAX,3), SUBJ$(3) OF 10, KEY'(MAX)
0110 DIM SPACES$ OF 39
0120 //*
0130 SUBJ$(1):="ENGLISH"
0140 SUBJ$(2):="MATH"
0150 SUBJ$(3):="FRENCH"
0160 SPACES$(1:39):=""
0190 //
0200 STARTSYSTEM
0210 //
0220 //* MAINLINES *//
0230 REPEAT
0240 CLEAR'SCREEN
0250 FIELD(8,15)
0260 PRINT "1=CORRECTIONS"
0270 PRINT "2=DELETE"
0280 PRINT "3=LOOKUP"
0290 PRINT "4=STOP"
0300 PRINT
0310 INPUT "> ": JOBCODE
0320 IF JOBCODE=1 THEN CORRECTIONS
0330 IF JOBCODE=2 THEN ERASE
0340 IF JOBCODE=3 THEN LOOKUP
0350 IF JOBCODE=4 THEN STOPSYSTEM
0360 UNTIL FALSE
0370 //
0380 PROC CORRECTIONS
0390 CLEAR'SCREEN
0400 TAKEIN("PUPILNO")
0410 DISPLAY
0420 INPUT "CORRECTIONS (YES/NO)? ": ANSW$
0430 IF ANSW$="YES" THEN
0440 TAKEIN("SUBJECT")
0450 TAKEIN("MARK")
0460 ENDIF
0470 ENDPROC CORRECTIONS
0480 //
0490 PROC ERASE
0500 CLEAR'SCREEN
0510 TAKEIN("PUPILNO")
0520 DISPLAY
0530 PRINT
0540 PRINT "DO YOU WANT TO DELETE THE RECORD"
0550 PRINT "DISPLAYED ABOVE (YES/RETURN)",
0560 INPUT ANSW$
0570 IF ANSW$="YES" THEN NAME$(PUPILNO):=""
0580 ENDPROC ERASE
0590 //
0600 PROC TAKEIN(MATTER$)
0610 REPEAT
0620 FIELD(8,10)
0630 CASE MATTER$ OF
0640 WHEN "PUPILNO"
0650 INPUT "PUPIL NUMBER: ": PUPILNO
0660 WHEN "SUBJECT"
0670 PRINT "ENGLISH, MATH, FRENCH",
0680 INPUT ANSW$
0690 WHEN "MARK"
0700 PRINT "THE CORRECT MARK IN ",SUBJ$(SUBJNO)
0710 PRINT "FOR THE PUPIL ",NAME$(PUPILNO)," IS:",
0720 INPUT " ": THISMARK
0730 ENDCASE
0740 CONTROL
0750 UNTIL OK
0760 CLEAR'SCREEN
0770 ENDPROC TAKEIN
0780 //
0790 PROC CONTROL
0800 CASE MATTER$ OF
0810 WHEN "PUPILNO"
0820 EXISTS:=FALSE
0830 OK:=(0<PUPILNO AND PUPILNO<=MAX)
0840 IF OK THEN EXISTS:=(NAME$(PUPILNO)<>"")
0850 OK:=OK AND EXISTS
0860 WHEN "SUBJECT"
0870 I:=1
0880 WHILE ANSW$<>SUBJ$(I) AND I<3 DO I:=I+1
0890 OK:=(ANSW$=SUBJ$(I)); SUBJNO:=I
0900 WHEN "MARK"
0910 OK:=(0<=THISMARK AND THISMARK<=5)
0920 IF OK THEN MARK(PUPILNO,SUBJNO):=THISMARK
0930 ENDCASE
0940 IF NOT OK THEN ERROR(4)
0950 ENDPROC CONTROL
0960 //
0970 PROC ERROR(NO)
0980 FIELD(1,3)
0990 PRINT "ERROR!"
1000 //
1010 //NOT FINISHED//
1020 //
1030 ENDPROC ERROR
1040 //
1050 //
1060 PROC FIELD(L1,L2)
1070 SCREEN(L1,1)
1080 FOR I:=1 TO L2-L1+1 DO PRINT SPACES$
1090 SCREEN(L1,1)
1100 PRINT
1110 ENDPROC FIELD
1120 //
1130 PROC SCREEN(ROW,COL) CLOSED
1140 PRINT CHR$(19) //HOME
1150 FOR I:=1 TO ROW DO PRINT //DOWN
1155 FOR I:=1 TO COL-1 DO PRINT CHR$(29), //RIGHT
1160 ENDPROC SCREEN
1170 //
1180 PROC STARTSYSTEM
1190 OPEN FILE 2,"MARKBOOKS",READ
1200 FOR PUPILNO:=1 TO MAX DO
1210 READ FILE 2: NAME$(PUPILNO)
1220 FOR SUBJNO:=1 TO 3 DO READ FILE 2: MARK(PUPILNO,SUBJNO)
1230 ENDFOR PUPILNO
1240 CLOSE
1250 ENDPROC STARTSYSTEM
1260 //
1270 PROC STOPSYSTEM
1280 OPEN FILE 2,"@0:MARKBOOKS",WRITE
1290 FOR PUPILNO:=1 TO MAX DO
1300 WRITE FILE 2: NAME$(PUPILNO)
1310 FOR SUBJNO:=1 TO 3 DO WRITE FILE 2: MARK(PUPILNO,SUBJNO)
1320 ENDFOR PUPILNO
1330 CLOSE
1340 STOP
1350 ENDPROC STOPSYSTEM
1360 //
1370 PROC LOOKUP
1380 CLEAR'SCREEN
1390 TAKEIN("PUPILNO")
1400 DISPLAY
1410 PRINT
1420 INPUT "PRESS RETURN-KEY: ": ANSW$
1430 ENDPROC LOOKUP
1440 //
1450 PROC DISPLAY
1460 CLEAR'SCREEN
1470 FIELD(8,20)
1480 IF NAME$(PUPILNO)<>"" THEN
1490 THISNAME$:=NAME$(PUPILNO)
1500 PRINT "PUPIL NUMBER ",PUPILNO,", ",THISNAME$
1510 PRINT "HAS ACHIEVED THE FOLLOWING RESULTS:"
1520 PRINT
1530 FOR SUBJNO:=1 TO 3 DO
1540 PRINT SUBJ$(SUBJNO),": ",
1550 PRINT TAB(25),MARK(PUPILNO,SUBJNO)
1560 ENDFOR SUBJNO
1570 ENDIF
1580 PRINT
1590 ENDPROC DISPLAY
1600 //
1610 PROC CLEAR'SCREEN
1620 PRINT CHR$(147),
1630 ENDPROC CLEAR'SCREEN
1640 //